home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1995.rar / 1995 / DEC / DI9512BV / unit1.pas < prev   
Pascal/Delphi Source File  |  1995-10-26  |  3KB  |  126 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Grids, Outline, StdCtrls, ExtCtrls, Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Outline1: TOutline;
  12.     Image1: TImage;
  13.     Label1: TLabel;
  14.     BitBtn1: TBitBtn;
  15.     Label2: TLabel;
  16.     procedure Outline1Click(Sender: TObject);
  17.     procedure Outline1DrawItem(Control: TWinControl; Index: Integer;
  18.       Rect: TRect; State: TOwnerDrawState);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  21.     procedure BitBtn1Click(Sender: TObject);
  22.   private
  23.     { Private declarations }
  24.   public
  25.     { Public declarations }
  26.   end;
  27.  
  28. var
  29.   Form1:    TForm1;
  30.  
  31. implementation
  32. var
  33.   bmpMalePyr,
  34.   bmpFemalePyr:  TBitMap;
  35.  
  36. {$R *.DFM}
  37.  
  38. procedure TForm1.Outline1Click(Sender: TObject);
  39. begin
  40. Form1.Caption :='Outline Index ' + inttostr(Outline1.SelectedItem) + '.  ' +
  41.                  Outline1.Items[Outline1.SelectedItem].FullPath
  42.  
  43. end;
  44.  
  45. procedure TForm1.Outline1DrawItem(Control: TWinControl; Index: Integer;
  46.   Rect: TRect; State: TOwnerDrawState);
  47.  
  48. Var
  49.    s:        String;
  50.    x, y:    Integer;
  51.    ItemIndex:    LongInt;
  52.    Node:    ToutlineNode;
  53.    Offset:    Integer;
  54.  
  55. begin
  56.    ItemIndex := Outline1.GetItem(Rect.Left, Rect.Top);
  57.    Node := Outline1.Items[ItemIndex];
  58.  
  59.    with Outline1.Canvas do
  60.    Begin
  61.  
  62.       if State = [odSelected, odFocused] then
  63.          Begin
  64.            Brush.Color := clHighlight;
  65.          Pen.Color := clHighlightText;
  66.          end
  67.       else
  68.          Begin
  69.            Brush.Color := Outline1.Color;
  70.          Pen.Color := clWindowText;
  71.       end;
  72.  
  73.       FillRect(Rect);
  74.  
  75.       Rect.Left := Rect.Left + (Node.Level * 15);
  76.  
  77.       { First draw the Icon }
  78.       if Copy(Node.Text,length(Node.Text),1) = 'F' then
  79.          BrushCopy(Bounds(Rect.Left,Rect.Top,35,25),
  80.                    bmpFemalePyr,
  81.                    Bounds(0, 0, 35, 25),
  82.                    clLtGray)
  83.        else
  84.          BrushCopy(Bounds(Rect.Left,Rect.Top,35,25),
  85.                    bmpMalePyr,
  86.                    Bounds(0, 0, 35, 25),
  87.                    clLtGray);
  88.  
  89.       { Set the font }
  90.       Font := Outline1.Font;
  91.  
  92.       { Then draw the string }
  93.       s := copy(Node.Text, 1, Length(Node.Text) - 2);
  94.  
  95.       { Indent and center Text }
  96.       x := Rect.left + bmpMalePyr.Width + 7;
  97.       y := Rect.Top + (((Rect.Bottom - Rect.Top) - abs(Font.Height)) div 2);
  98.       TextOut(x, y, s);
  99.  
  100.    end;
  101. end;
  102.  
  103. procedure TForm1.FormCreate(Sender: TObject);
  104.  
  105. begin
  106. { Load the bitmap from the current directory }
  107.  
  108. bmpMalePyr := TBitMap.Create;
  109. bmpMalePyr.LoadFromFile('MalePyr.Bmp');
  110. bmpFemalePyr := TBitMap.Create;
  111. bmpFemalePyr.LoadFromFile('FemPyr.Bmp');
  112. end;
  113.  
  114. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  115. begin
  116. bmpMalePyr.Free;
  117. bmpFemalePyr.Free;
  118. end;
  119.  
  120. procedure TForm1.BitBtn1Click(Sender: TObject);
  121. begin
  122. Form1.Close;
  123. end;
  124.  
  125. end.
  126.